home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol061 / cvrisk.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-13  |  10.0 KB  |  251 lines
  1. 70 CLS: LOCATE 8,25,0: COLOR 7,0,0:PRINT"CARDIOVASCULAR RISK CALCULATION"
  2. 72 LOCATE 10,19,0:PRINT"adapted from the Michigan Heart Association"
  3. 74 LOCATE 12,30,0:PRINT"by John S. Zesk, M.D."
  4. 76 LOCATE 22,28,0:PRINT"Press any key to Continue"
  5. 80 W$=INKEY$:IF W$="" THEN 80 ELSE 82
  6. 82 CLS:LOCATE 6,16,0:PRINT"This program is an adaptation of a game produced by the"
  7. 84 LOCATE 8,16,0:PRINT"Michigan Heart Association which calculates the risk of"
  8. 86 LOCATE 10,16,0:PRINT"a `CARDIOVASCULAR EVENT' ( Heart Attack or new Angina )
  9. 88 LOCATE 12,16,0:PRINT"within the next seven years."
  10. 90 LOCATE 16,16,0:PRINT"Answer the questions which follow with the appropriate"
  11. 92 LOCATE 18,16,0:PRINT"numerical entries to evaluate YOUR RISK !"
  12. 94 LOCATE 24,30,0:PRINT"Press any key to Continue"
  13. 96 Q$=INKEY$:IF Q$="" THEN 96 ELSE 98
  14. 98 CLS: COLOR 7,0,0
  15. 130 PRINT:PRINT:PRINT:PRINT
  16. 140 PRINT
  17. 150 C$="YOUR CARDIOVASCULAR RISK IS <"
  18. 160 D$="> WHICH IS BELOW AVERAGE"
  19. 170 E$="> WHICH IS GENERALLY AVERAGE"
  20. 180 F$="> WHICH IS MODERATE"
  21. 190 G$="> WHICH IS AT A DANGEROUS LEVEL"
  22. 200 H$="> WHICH INDICATES AN URGENT DANGER"
  23. 210 PRINT "                                 ENTER AGE RATING"
  24. 220 PRINT:PRINT
  25. 230 PRINT "                            Age 10 - 20  *  Enter <1>"
  26. 235 PRINT
  27. 240 PRINT "                            Age 21 - 30  *  Enter <2>"
  28. 245 PRINT
  29. 250 PRINT "                            Age 31 - 40  *  Enter <3>"
  30. 255 PRINT
  31. 260 PRINT "                            Age 41 - 50  *  Enter <4>"
  32. 265 PRINT
  33. 270 PRINT "                            Age 51 - 60  *  Enter <6>"
  34. 275 PRINT
  35. 280 PRINT "                            Age 61 and over  *  Enter <8>"
  36. 290 LOCATE 21,40,0:INPUT A
  37. 300 CLS:PRINT:PRINT:PRINT:PRINT
  38. 310 PRINT
  39. 320 PRINT "                               ENTER HEREDITY RATING"
  40. 330 PRINT:PRINT
  41. 340 PRINT "              No known history of heart disease * Enter <1>"
  42. 345 PRINT
  43. 350 PRINT "              1 relative with cardiovascular disease over 60 * Enter <2>"
  44. 355 PRINT
  45. 360 PRINT "              2 relatives with cardiovascular disease over 60 * Enter <3>"
  46. 365 PRINT
  47. 370 PRINT "              1 relative with cardiovascular disease under 60 * Enter <4>"
  48. 375 PRINT
  49. 380 PRINT "              2 relatives with cardiovascular disease under 60 * Enter <6>"
  50. 385 PRINT
  51. 390 PRINT "              3 relatives with cardiovascular disease under 60 * Enter <7>"
  52. 400 LOCATE 21,40,0:INPUT B
  53. 410 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  54. 420 PRINT
  55. 430 PRINT "                                ENTER WEIGHT RATING"
  56. 440 PRINT:PRINT
  57. 450 PRINT "                      More than 5 lbs. below standard weight * Enter <0>"
  58. 455 PRINT
  59. 460 PRINT "                      -5 to +5 lbs. standard weight * Enter <1>"
  60. 465 PRINT
  61. 470 PRINT "                      6 to 20 lbs. overweight * Enter <2>"
  62. 475 PRINT
  63. 480 PRINT "                      21 to 35 lbs. overweight * Enter <3>"
  64. 485 PRINT
  65. 490 PRINT "                      36 to 50 lbs. overweight * Enter <5>"
  66. 495 PRINT
  67. 500 PRINT "                      51 or more lbs. overweight * Enter <7>"
  68. 510 LOCATE 22,40,0:INPUT C
  69. 520 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  70. 530 PRINT
  71. 540 PRINT "                          ENTER TOBACCO SMOKING RATING"
  72. 550 PRINT:PRINT
  73. 560 PRINT "                        Non-user * Enter <0>"
  74. 565 PRINT
  75. 570 PRINT "                        Cigar and/or pipe * Enter <1>"
  76. 575 PRINT
  77. 580 PRINT "                        10 cigarettes or less a day * Enter <2>"
  78. 585 PRINT
  79. 590 PRINT "                        20 cigarettes a day * Enter <4>"
  80. 595 PRINT
  81. 600 PRINT "                        30 cigarettes a day * Enter <6>"
  82. 605 PRINT
  83. 610 PRINT "                        40 cigarettes or more a day * Enter <10>"
  84. 620 LOCATE 22,40,0:INPUT D
  85. 630 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  86. 640 PRINT
  87. 650 PRINT "                                 ENTER EXERCISE RATING"
  88. 660 PRINT:PRINT
  89. 670 PRINT "              Intensive occupational and recreational exertion * Enter <1>"
  90. 675 PRINT
  91. 680 PRINT "              Moderate occupational and recreational exertion * Enter <2>"
  92. 685 PRINT
  93. 690 PRINT "              Sedentary work and intense recreational exertion * Enter <3>"
  94. 695 PRINT
  95. 700 PRINT "              Sedentary work and moderate recreational exertion * Enter <5>"
  96. 705 PRINT
  97. 710 PRINT "              Sedentary work and light recreational exertion * Enter <6>"
  98. 715 PRINT
  99. 720 PRINT "              Complete lack of all exercise * Enter <8>"
  100. 730 LOCATE 22,40,0:INPUT E
  101. 740 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  102. 750 PRINT
  103. 760 PRINT "                              ENTER CHOLESTEROL RATING"
  104. 770 PRINT:PRINT
  105. 780 PRINT "                        Cholesterol below 180 mg. * Enter <1>"
  106. 785 PRINT
  107. 790 PRINT "                        Cholesterol 181-205 mg. * Enter <2>"
  108. 795 PRINT
  109. 800 PRINT "                        Cholesterol 206-230 mg. * Enter <3>"
  110. 805 PRINT
  111. 810 PRINT "                        Cholesterol 231-255 mg. * Enter <4>"
  112. 815 PRINT
  113. 820 PRINT "                        Cholesterol 256-280 mg. * Enter <5>"
  114. 825 PRINT
  115. 830 PRINT "                        Cholesterol 281 or more mg. * Enter <7>"
  116. 840 LOCATE 22,40,0:INPUT F
  117. 850 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  118. 860 PRINT
  119. 870 PRINT "                            ENTER BLOOD PRESSURE RATING"
  120. 880 PRINT:PRINT
  121. 890 PRINT "                           100 upper reading * Enter <1>"
  122. 895 PRINT
  123. 900 PRINT "                           120 upper reading * Enter <2>"
  124. 905 PRINT
  125. 910 PRINT "                           140 upper reading * Enter <3>"
  126. 915 PRINT
  127. 920 PRINT "                           160 upper reading * Enter <4>"
  128. 925 PRINT
  129. 930 PRINT "                           180 upper reading * Enter <6>"
  130. 935 PRINT
  131. 940 PRINT "                           200 or over upper reading * Enter <8>"
  132. 950 LOCATE 22,40,0:INPUT G
  133. 960 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  134. 970 PRINT
  135. 980 PRINT "                                 ENTER SEX RATING"
  136. 990 PRINT:PRINT
  137. 1000 PRINT "                            Female under 40 * Enter <1>"
  138. 1005 PRINT
  139. 1010 PRINT "                            Female 40-50 * Enter <2>"
  140. 1015 PRINT
  141. 1020 PRINT "                            Female over 50 * Enter <3>"
  142. 1025 PRINT
  143. 1030 PRINT "                            Male * Enter <5>"
  144. 1035 PRINT
  145. 1040 PRINT "                            Stocky male * Enter <6>"
  146. 1045 PRINT
  147. 1050 PRINT "                            Bald stocky male * Enter <7>"
  148. 1060 LOCATE 22,40,0:INPUT H
  149. 1070 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
  150. 1080 PRINT
  151. 1090 LET X=A+B+C+D+E+F+G+H
  152. 1100 IF X<18 GOTO 1170
  153. 1110 IF X<25 GOTO 1190
  154. 1120 IF X<32 GOTO 1210
  155. 1130 IF X<41 GOTO 1230
  156. 1140 IF X<63 GOTO 1250
  157. 1150 LOCATE 12,31,0:PRINT "PLEASE RECHECK DATA ENTRIES!"
  158. 1152 LOCATE 20,27,0:PRINT"Press any key to begin Recalculation"
  159. 1154 V$=INKEY$:IF V$="" THEN 1154 ELSE 98
  160. 1170 LOCATE 10,14,0:PRINT C$;X;D$
  161. 1180 GOTO 1270
  162. 1190 LOCATE 10,14,0:PRINT C$;X;E$
  163. 1200 GOTO 1270
  164. 1210 LOCATE 10,17,0:PRINT C$;X;F$
  165. 1220 GOTO 1270
  166. 1230 LOCATE 10,14,0:PRINT C$;X;G$
  167. 1240 GOTO 1270
  168. 1250 LOCATE 10,10,0:PRINT C$;X;H$
  169. 1260 GOTO 1270
  170. 1270 LOCATE 13,31,0:PRINT "DO YOU WISH A TYPED REPORT ?"
  171. 1280 LOCATE 14,31,0:PRINT "ENTER <YES> OR <NO>"
  172. 1290 LOCATE 16,37,0:INPUT A$
  173. 1300 IF A$="YES" THEN 1320
  174. 1310 IF A$="NO" THEN GOTO 2010
  175. 1320 CLS:LOCATE 10,14,0:PRINT"PLEASE ENTER <NAME>"
  176. 1330 LOCATE 10,35,0:INPUT B$
  177. 1340 LOCATE 14,14,0:PRINT "PLEASE BE SURE PRINTER IS ON AND LOADED WITH PAPER"
  178. 1350 LPRINT "      ";B$
  179. 1360 LPRINT
  180. 1370 IF X<18 GOTO 1420
  181. 1380 IF X<25 GOTO 1440
  182. 1390 IF X<32 GOTO 1460
  183. 1400 IF X<41 GOTO 1480
  184. 1410 IF X<63 GOTO 1500
  185. 1420 LPRINT "      ";C$;X;D$
  186. 1430 GOTO 1520
  187. 1440 LPRINT "      ";C$;X;E$
  188. 1450 GOTO 1520
  189. 1460 LPRINT "      ";C$;X;F$
  190. 1470 GOTO 1520
  191. 1480 LPRINT "      ";C$;X;G$
  192. 1490 GOTO 1520
  193. 1500 LPRINT "      ";C$;X;H$
  194. 1510 GOTO 1520
  195. 1520 LPRINT
  196. 1530 LPRINT "      THE RISK FACTORS OF AGE, HEREDITY, AND SEX CANNOT BE ALTERED
  197. 1540 LPRINT
  198. 1550 LPRINT "      THE RISK FACTORS OF OBESITY, SMOKING, LACK OF EXERCISE, ELEVATED"
  199. 1560 LPRINT "      CHOLESTEROL, AND HIGH BLOOD PRESSURE CAN BE REDUCED!"
  200. 1570 LPRINT
  201. 1580 LET Y=C+D+E+F+G-3
  202. 1590 LPRINT "                IF YOU WERE ABLE TO:"
  203. 1600 LPRINT
  204. 1610 LPRINT"                 1. MAINTAIN IDEAL BODY WEIGHT"
  205. 1620 LPRINT"                 2. NOT SMOKE"
  206. 1630 LPRINT"                 3. EXERCISE REGULARLY"
  207. 1640 LPRINT"                 4. LOWER CHOLESTEROL THROUGH DIET"
  208. 1650 LPRINT"                 5. REDUCE BLOOD PRESSURE"
  209. 1660 LPRINT
  210. 1670 LPRINT"      YOU COULD LOWER YOUR RISK RATING BY AS MUCH AS <";Y;"> POINTS!"
  211. 1680 LPRINT
  212. 1690 LET Z=X-Y
  213. 1700 IF Z<18 GOTO 1720
  214. 1710 IF Z<25 GOTO 1740
  215. 1720 LPRINT"      THIS WOULD LOWER YOUR RISK TO <";Z;D$
  216. 1730 GOTO 1760
  217. 1740 LPRINT "      THIS WOULD LOWER YOUR RISK TO <";Z;E$
  218. 1750 GOTO 1760
  219. 1760 LPRINT
  220. 1770 LPRINT "             RISK FACTOR     YOUR SCORE     RANGE"
  221. 1780 LPRINT
  222. 1790 LPRINT "                AGE             <";A;">       <1-8>"
  223. 1800 LPRINT "              HEREDITY          <";B;">       <1-7>"
  224. 1810 LPRINT "               WEIGHT           <";C;">       <0-7>"
  225. 1820 LPRINT "              SMOKING           <";D;">       <0-10>"
  226. 1830 LPRINT "              EXERCISE          <";E;">       <1-8>"
  227. 1840 LPRINT "             CHOLESTEROL        <";F;">       <1-7>"
  228. 1850 LPRINT "           BLOOD PRESSURE       <";G;">       <1-8>"
  229. 1860 LPRINT "                SEX             <";H;">       <1-7>"
  230. 1870 LPRINT
  231. 1880 LPRINT
  232. 1890 LPRINT "                CARDIOVASCULAR RISK RANGES"
  233. 1900 LPRINT
  234. 1910 LPRINT "                <12-17> RISK BELOW AVERAGE"
  235. 1920 LPRINT "                <18-24> RISK GENERALLY AVERAGE"
  236. 1930 LPRINT "                <25-31> RISK MODERATE"
  237. 1940 LPRINT "                <32-40> RISK AT A DANGEROUS LEVEL"
  238. 1950 LPRINT "                <41-62> RISK INDICATES URGENT DANGER"
  239. 1960 LOCATE 17,14,0:PRINT "DO YOU WISH ANOTHER COPY OF THIS REPORT?"
  240. 1970 LOCATE 18,14,0:PRINT "ENTER <YES> OR <NO>"
  241. 1980 LOCATE 18,33,0:INPUT Q$
  242. 1990 IF Q$="YES" THEN 1350
  243. 2000 IF Q$="NO" THEN GOTO 2010
  244. 2010 CLS:LOCATE 11,14,0:PRINT"DO YOU WISH TO ANALYZE ANOTHER INDIVIDUAL'S RISK PROFILE?"
  245. 2020 LOCATE 14,31,0:PRINT"ENTER <YES> OR <NO>"
  246. 2030 LOCATE 14,51,0:INPUT P$
  247. 2040 IF P$="YES" THEN GOTO 98
  248. 2050 IF P$="NO" THEN GOTO 2060
  249. 2060 LOCATE 22,34,0:PRINT"HAVE A GOOD DAY !"
  250. 2070 END
  251.